Info-Mac 3/Info_Mac_1994-01.iso/Text Processing/Alpha 5.63/Tcl/SystemCode/shell.tcl

Text File | 1993-11-20 | 4.9 KB | 234 lines | [TEXT/ALFA]

################################################################################
# Shell routines.
################################################################################


proc setShellMode {} {
    setTclMode
    changeMode "Csh"
    insertMenu "Tcl"
}

proc initShell {} {
    insertText "Welcome to Alpha's Tcl shell."
    insertText -w [lindex [winNames] 0] [shellPrompt]
}

# Return the prompt. We want the window name because some of the commands
# we evaluate (such as 'edit') open a new window, and we want the insertion
# to be done in the shell window.
proc shellPrompt {} {
    regexp "(\[^:\]*):$" [pwd] crDum crDir
    return "\r$crDir> "
}


# Called at all carriage returns.
proc carriageReturn {} {
    global mode
    global indentOnCR
    set indentString ""
    deleteText [getPos] [selEnd]
    if {$indentOnCR} {
        set pos [getPos]
        set text [getText [lineStart $pos] $pos]
        for {set i 0; set len [string length $text]} {$i <= $len} {incr i} {
            set c [string index $text $i]
            if {($c != "\t") && ($c != "\ ")} {
                set indentString [string range $text 0 [expr $i-1]]
                break
            }
        }
    }
    insertText "\r" $indentString
}


proc tclCarriageReturn {} {
    global mode
    global _text
    global _returnText
    set pos [getPos]
    set ind [string first ">" [getText [lineStart $pos] $pos]]
    if {$ind < 0} {
        carriageReturn
        return
    }
    set lStart [expr [lineStart $pos]+$ind+2]
    endOfLine
    set _text [getText $lStart [getPos]]
    set fileName [lindex [winNames] 0]
    if {[getPos] != [maxPos]} {
        goto [maxPos]
        insertText -w $fileName $_text
    }
    if {[string first "Toolserver" $fileName] != -1} {
        if {![catch {dosc -n ToolServer -s $_text} _returnText]} {
            insertText "\r" $_returnText
        } else {
            insertText "\r"
        }
        mpwPrompt
    } else {
        uplevel #0 {catch $_text _returnText}
        if {[string length $_returnText]} {
            insertText -w $fileName "\r" $_returnText [shellPrompt]
        } else {
            insertText -w $fileName [shellPrompt]
        }
    }
    unset _text
    unset _returnText
}
bind '\r' carriageReturn
bind '\r' tclCarriageReturn "Csh"
bind '\r' tclCarriageReturn "MPW"

proc startMPW {} {
    global toolserverPath

    if {![string length [checkRunning ToolServer MPSX toolserverPath]]} return

    insertText "Welcome to Alpha's MPW shell (using ToolServer via AppleEvents)."
    bind '\r' tclCarriageReturn "MPW"
    carriageReturn
    mpwPrompt
}
proc mpwPrompt {} {
    insertText "mpw> "
}

proc setMPWMode {} {
    changeMode "MPW"
}

#    tclCarriageReturn



#=============================================================================
#    Shell Aliases
#=============================================================================
proc l {args} {
    eval [concat "ls -F" $args]}

proc ll {args} {
    eval [concat "ls -l" $args]}


proc grep {pat args} {
    set args [glob -nocomplain $args]
    foreach file $args {
        set id [open $file]
        if {[regexp $pat [read $id]]} {
            close $id
            set id [open $file]
            while {[gets $id string] != "-1"} {
                if {[regexp $pat $string] == 1} {
                    insertText \r$file: $string
                }
            }
            close $id
        } else {
            close $id
        }
    }
}


proc wc {args} {
    set totChars 0
    set totLines 0
    set totWords 0
    set args [glob -nocomplain $args]
    foreach file $args {
        set id [open $file]
        set chars [string length [set text [read $id]]]
        set lines [llength [split $text "\n"]]
        set words [llength [split $text]]
        insertText [format "\r%8d%8d%8d    $file" $lines $words $chars]
        set totChars [expr $totChars+$chars]
        set totWords [expr $totWords+$words]
        set totLines [expr $totLines+$lines]
        close $id
    }
    if {[llength $args] > 1} {
        insertText [format "\r%8d%8d%8d    total" $totLines $totWords $totChars]
    }
}

proc cp args {
    if {[set len [llength $args]] < 2} {
        error "usage: cp <file1> <file2>\r       cp <file1> .... <dir>"
    }
    set len [expr $len-1]
    regexp {.*[^:]} [lindex $args $len] dir
    set args [lreplace $args $len $len]
    set files {}
    foreach arg $args {
        append files " " [glob $arg]
    }
    if {[llength $files] == 1} {
        set f [lindex $files 0]
        if {[file exists $dir]} {
            copyFile $f $dir:[file tail $f]
        } else {
            copyFile $f $dir
        }
    } else {
        foreach f $files {
            if {[catch {copyFile $f $dir:[file tail $f]}]} {
                alertnote "Error copying '$f'"
            }
        }
    }
}

proc mv args {
    if {[set len [llength $args]] < 2} {
        error "usage: mv <file1> <file2>\r       mv <file1> .... <dir>"
    }
    set len [expr $len-1]
    regexp {.*[^:]} [lindex $args $len] dir
    set args [lreplace $args $len $len]
    set files {}
    foreach arg $args {
        append files " " [glob $arg]
    }
    if {[llength $files] == 1} {
        set f [lindex $files 0]
        if {[file exists $dir]} {
            moveFile $f $dir:[file tail $f]
        } else {
            moveFile $f $dir
        }
    } else {
        foreach f $files {
            if {[catch {moveFile $f $dir:[file tail $f]}]} {
                alertnote "Error copying '$f'"
            }
        }
    }
}


proc rm args {
    set files {}
    foreach arg $args {
        append files " " [glob $arg]
    }
    foreach f $files {
        removeFile $f
    }
}


proc cd args {
    if {[llength $args]} {
        changeDir [string trim [eval list $args] "\{\}"]
    } else {
        changeDir
    }
}